home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr05
/
ewrtgn10.zip
/
EWRTFGEN.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-07-17
|
25KB
|
1,048 lines
{ EWRTFGEN }
(********* Source code (C) Copyright 1992, by L. David Baldwin *********)
(********* Source code (C) Copyright 1993, by Patrick Philippot *********)
(********* All Rights Reserved *********)
{************************************************}
{ }
{ E! for Windows }
{ (c) - Patrick Philippot - 1992,1993 }
{ }
{ EWRTFGEN Extension DLL - version 1.0 }
{ }
{ This DLL translates the current text to a }
{ .RTF file suitable for the Windows Help }
{ compiler, provided it complies to the syntax }
{ defined by RTFGEN (see doc.). }
{ }
{************************************************}
{$C MOVEABLE DEMANDLOAD DISCARDABLE}
Library EWRTFGEN;
{$IFDEF DEBUG}
{$A+,G+,B-,D+,E-,F+,I-,N-,R+,S+,V-,L+,Q+,Y+,K+,X+}
{$ELSE}
{$A+,G+,B-,D-,E-,F+,I-,N-,R-,S-,V-,L-,Q-,Y-,K+,X+}
{$ENDIF}
Uses WinProcs, WinTypes, EWAPIIMP, Strings;
Const
TwipsPerSpace = 120;
DefaultFont : String[6] = '2';
DefaultFontSize : String[10] = '20';
ParaChar : Char = '`';
Tokenleng = 28; {Max symbol length}
Tab = #9;
MaxRes = 13;
Type
Symb = (
OtherChar, Comma, Colon, SemiColon, Lbrack, Rbrack, Dot, Slash,
LLbrack, RRbrack, OtherPunct, Ident, EolSy, Space, ParaSy, TabSy,
BuildTagSy, TopicSy, TitleSy, KeyWordSy, BrowseSy,
TopicStart, TopicEnd, DocStartSy, DocEndSy, CommandSy, BMCSy, BMLSy,
BMRSy, FontCommand, Number, BlockStartSy, BlockEndSy);
SymString = string[14];
Var
Sy, SaveSy : Symb;
Const
ResWord : array[1..MaxRes] of SymString = (
'\buildtag', '\topic', '\title', '\keyword', '\browse', '\bmc', '\bml',
'\bmr', '\docstart', '\docend', '\tab', '\blockstart', '\blockend');
ResSy : array[1..MaxRes] of Symb = (
BuildTagSy, TopicSy, TitleSy, KeyWordSy, BrowseSy, BMCSy, BMLSy,
BMRSy, DocStartSy, DocEndSy, TabSy, BlockStartSy, BlockEndSy);
Type
TokenString = string[Tokenleng];
String127 = string[127];
Filestring = string[79];
PairType = array[0..1] of Char;
Var
BrackCount, LineNo, Chi, ErrCount : Integer;
Pair : Word;
Spair : PairType absolute Pair;
LCh : Char absolute Pair;
UCh : Char;
St : String127;
ErrFlag, EofInf, InInclude, InTopic : Boolean;
SourceName : Filestring;
Outf : Text;
Value : LongInt;
LCToken : TokenString;
OutString, GlobalHeader, TopicHeader : String;
BlockHeader : array[1..4] of String;
BIndex : Integer;
OutName : FileString;
LineCount : integer;
const
RTFTitle : PChar = 'Translate to RTF';
var
SaveExit : Pointer; { Save ExitProc }
RTFEntryId : longint; { Entry Id for the "Translate to RTF" menu }
{-------------Error}
procedure Error(II :Integer; S : String127);
Var
X,Y : Integer;
ActualCol : integer;
Msg : array[0..127] of char;
begin
if II > 2 then
ActualCol := II - 3
else
ActualCol := 0;
Lineno := Pred(Lineno);
if Lineno < 0 then
Lineno := 0;
EWGotoXY(ActualCol, Lineno);
StrPCopy(Msg, S);
EWWriteMessage(Msg);
ErrFlag := true;
end;
{-------------SetWaitCursor}
procedure SetWaitCursor(state : boolean);
const
OldCursor : HCursor = 0;
begin
if state then
OldCursor := SetCursor(LoadCursor(0, idc_Wait))
else if OldCursor <> 0 then
SetCursor(OldCursor);
end;
{-------------Positn}
function Positn(Pat, Src : String; I : Integer) : Integer;
{-Find the position of a substring in a string starting at the Ith char}
var
N : Integer;
begin
if I < 1 then
I := 1;
Delete(Src, 1, I-1);
N := Pos(Pat, Src);
if N = 0 then
Positn := 0
else
Positn := N+I-1;
end;
{-------------HexString}
procedure HexString(Number : integer; var Result : String);
var
Tmp : integer;
i : integer;
begin
for i := 1 to 2 do begin
Tmp := Number and $F;
Number := Number shr 4;
if Tmp >= 10 then
Result[3-i] := Chr(Tmp - 10 + Ord('a'))
else
Result[3-i] := Chr(Tmp + Ord('0'));
end;
Result[0] := Char(2);
end;
{-------------ConvertForeign}
procedure ConvertForeign;
{-Makes sure that accented characters will be processed correctly}
var
HexStr : String[2];
RTFStr : String[4];
i : word;
begin
i := 1;
while not ErrFlag and (i <= Length(OutString)) do begin
if Ord(OutString[i]) > $A0 then begin
HexString(Ord(OutString[i]), HexStr);
RTFStr := '\''' + HexStr;
if Length(OutString) + 4 <= 255 then begin
Delete(OutString, i , 1);
Insert(RTFStr, OutString, i);
Inc(i, 3);
end else
Error(i, 'Could not replace ANSI character with RTF command. Please split line.');
end;
Inc(i);
end;
end;
{-------------OutFile}
procedure OutFile(S : String);
var
WriteIt : boolean;
Leng, I : Integer;
begin
{-A hard to find bug is mismatched braces. Keep count of these so can keep track of matching.}
I := 0;
repeat
I := Positn('{', S, I+1);
if (I > 0) then
if not ((I > 1) and (S[I-1] = '\')) then
Inc(BrackCount);
until I = 0;
repeat
I := Positn('}', S, I+1);
if (I > 0) then
if not ((I > 1) and (S[I-1] = '\')) then
Dec(BrackCount);
until I = 0;
{-Try to avoid hanging spaces on end of lines as editors delete them}
Leng := Length(OutString)+Length(S);
WriteIt := (Leng >= 75) and (OutString[Length(OutString)] <> ' ') or (Leng >= 200);
if WriteIt then begin
ConvertForeign;
WriteLn(Outf, OutString);
OutString := S;
end else
OutString := OutString+S;
if IOResult <> 0 then
Error(Lineno, 'I/O Error while writing Output File');
end;
{-------------Flush}
procedure Flush;
begin
if Length(OutString) > 0 then begin
ConvertForeign;
WriteLn(Outf, OutString);
OutString := '';
end;
end;
{-------------GetCh}
procedure GetCh;
{-Return next char in Uch and Lch with Uch in upper case. Ignore comments}
Var
Comment : Boolean;
procedure GetchBasic;
{-Read a character and a character pair}
begin
if Chi<=Ord(St[0]) then begin {NOTE: pair has the same address as lch}
Pair := MemW[DSeg : Ofs(St[Chi])];
if (LCh=Tab) and not InTopic then
LCh:=' ';
UCh := UpCase(LCh);
Chi := Chi+1;
end else
if Lineno < LineCount then begin
St := StrPas(EWGetLineAt(Lineno));
Inc(LineNo);
St:=St+^M; {Add EOL}
Chi:=1;
GetCh;
end else begin
EofInf:=True;
if Comment then
Error(Lineno, 'Open Comment at End of Input File');
end;
end;
begin {Getch}
repeat
if EofInf then
Error(Lineno, 'Unexpected End of Input File');
Comment:=False;
GetchBasic;
if ErrFlag then
Exit;
if (SPair='(*') then begin
Comment:=True;
repeat
GetchBasic;
until ErrFlag or (SPair='*)');
if not ErrFlag then
GetchBasic; {pass by the '*'}
end;
until ErrFlag or not Comment;
end;
{-----------IsPair}
function IsPair : Boolean;
Const
Limit = 8;
PA : array[1..Limit] of PairType = (
'[[', ']]', '\[', '\]', '\\', '\`',
'\{', '\}'); {!! <- if '`' made optional, change!!}
Var
I : Integer;
Was : Pairtype;
begin
IsPair := False;
for I := 1 to Limit do
if PA[I] = Spair then begin
Was := SPair;
Sy := OtherPunct;
IsPair := True;
GetCh;
case I of
5,7,8 : LCToken := Was;
1 : Sy := LLbrack;
2 : Sy := RRbrack;
else
LCToken := LCh;
end;
GetCh;
Exit;
end;
end;
{-------------GetNumber}
function GetNumber : Boolean; {Pick up a Number}
Var
Done : Boolean;
Code : Integer;
begin
case UCh of
'0'..'9' : LCToken := '';
else begin
GetNumber := False;
Exit;
end;
end;
GetNumber := True;
Sy := Number;
Done := False;
if not EofInf then
while not ErrFlag and not Done do
case UCh of
'0'..'9' :
begin
LCToken := LCToken+UCh;
GetCh;
end;
else
Done := True;
end;
Val(LCToken, Value, Code);
end;
{-------------GetCommand}
function GetCommand : Boolean; {Pick up a Command}
Label 2;
const
MaxFC = 10;
FontCommands : array[1..MaxFC] of string[6] =
('f', 'fs', 'b', 'i', 'strike', 'ul', 'ulw', 'uld', 'uldb',
'plain');
Var
Done : Boolean;
I : Integer;
AlphaOnly : TokenString;
begin
GetCommand := False;
if UCh <> '\' then
Exit;
GetCommand := True;
Sy := CommandSy;
LCToken := LCh;
AlphaOnly := '';
GetCh;
Done := False;
if not EofInf then begin
while not ErrFlag and not Done do
case LCh of
'a'..'z' :
begin
if Length(LCToken)<Tokenleng then begin
Inc(LCToken[0]);
LCToken[Length(LCToken)] := LCh;
Inc(AlphaOnly[0]);
AlphaOnly[Length(AlphaOnly)] := LCh;
end;
GetCh;
end;
else
Done := True;
end;
if LCh = '-' then begin
if Length(LCToken)<Tokenleng then begin
Inc(LCToken[0]);
LCToken[Length(LCToken)] := LCh;
end;
GetCh;
end;
Done := False;
while not ErrFlag and not Done do
case LCh of
'0'..'9' :
begin
if Length(LCToken)<Tokenleng then begin
Inc(LCToken[0]);
LCToken[Length(LCToken)] := LCh;
end;
GetCh;
end;
else
Done := True;
end;
end;
for I := 1 to MaxRes do
if LCToken = ResWord[I] then begin
Sy := ResSy[I];
GOTO 2;
end;
if not InTopic then
for I := 1 to MaxFC do
if AlphaOnly = FontCommands[I] then begin
Sy := FontCommand;
GoTo 2;
end;
2 : {account for possible space after command}
if Length(LCToken)<Tokenleng then begin
Inc(LCToken[0]);
LCToken[Length(LCToken)] := ' ';
end;
if UCh = ' ' then
GetCh; {use up a space}
end;
{-------------GetIdent}
function GetIdent : Boolean; {Pick up a Symbol}
Var
Done : Boolean;
I : Integer;
begin
GetIdent := False;
case UCh of
'A'..'Z', '_' : ;
else
Exit;
end;
GetIdent := True;
Sy := Ident;
LCToken := LCh;
GetCh;
Done := False;
if not EofInf then
while not ErrFlag and not Done do
case UCh of
'A'..'Z', '0'..'9', '_' :
begin
if Length(LCToken)<Tokenleng then begin
Inc(LCToken[0]);
LCToken[Length(LCToken)] := LCh;
end;
GetCh;
end;
else
Done := True;
end;
end;
{-------------GetTopicEnd}
function GetTopicEnd : boolean;
begin
GetTopicEnd := False;
if UCh <> '-' then
Exit;
if Pos('----', St) <> 1 then
Exit;
Chi := Length(St)+1; {ignore remainder of St}
if not EofInf then
GetCh;
GetTopicEnd := True;
if not InTopic then begin
Error(Chi, '----- when not within topic');
Exit;
end;
Sy := TopicEnd;
end;
{-------------GetTopicStart}
function GetTopicStart : boolean;
begin
GetTopicStart := False;
if UCh <> '=' then
Exit;
if Pos('====', St) <> 1 then
Exit;
Chi := Length(St)+1; {ignore remainder of St}
if not EofInf then
GetCh;
GetTopicStart := True;
if InTopic then begin
Error(Chi, '==== when already within topic');
Exit;
end;
Sy := TopicStart;
end;
{-----------Punctuation}
function Punctuation : Boolean;
{-Check to see if Uch is a punctuation mark; if so, store the punctuation type in Sy}
Var
I : Integer;
Const
Punct : string[10] = ^M^I' :;[].';
SyArray : array[1..8] of Symb = (EOLSy, TabSy, Space, Colon, SemiColon, Lbrack, Rbrack, Dot);
begin
Punctuation := False;
I := Pos(UCh, Punct);
case I of
1..8 : Sy := SyArray[I];
else if UCH = ParaChar then
Sy := ParaSy
else
Exit;
end;
Punctuation := True;
case Sy of
EOLSy : LCToken := ' ';
ParaSy : LCToken := '';
TabSy : LCToken := '\tab ';
else
LCToken := LCh;
end;
GetCh;
end;
{-----------Next}
procedure Next;
{-Get the next token on the command line}
begin
if EofInf then begin
Error(Lineno, 'Unexpected end of input file');
Exit;
end;
if IsPair then
else if GetCommand then
else if GetIdent then
else if GetNumber then
else if GetTopicEnd then
else if GetTopicStart then
else if Punctuation then
else begin
Sy := OtherChar;
LCToken := LCh;
if not EOFinf then
GetCh;
end;
end;
{-------------SkipWhiteSpace}
procedure SkipWhiteSpace;
begin
while not ErrFlag and ((UCh = ' ') or (UCh = Tab)) do
GetCh;
end;
{-------------ParagraphText}
procedure ParagraphText;
procedure DoBitmap;
var
S : String[30];
Count : Integer;
const
FileChars : set of char = ['A'..'Z', 'a'..'z', '0'..'9', '!', '#'..'''', '@', '^'..'`', '~'];
begin
OutFile('\{');
case Sy of
BMCSy : S := 'bmc ';
BMRSy : S := 'bmr ';
BMLSy : S := 'bml ';
end;
SkipWhiteSpace;
Count := 0;
while not ErrFlag and (LCH in FileChars) do begin
S := S+LCh;
GetCh;
Inc(Count);
end;
if (Count > 8) or (Count = 0) then begin
Error(Chi, 'Filename expected');
Exit;
end;
if LCh = '.' then begin
S := S+LCh;
GetCh;
Count := 0;
while not ErrFlag and (LCH in FileChars) do begin
S := S+LCh;
GetCh;
Inc(Count);
end;
if (Count > 3) then begin
Error(Chi, 'Filename expected');
Exit;
end;
end;
Next;
OutFile(S+'\}');
end;
procedure CrossRef;
var
SyWas : Symb;
begin
SyWas := Sy;
if Sy = LBrack then
OutFile('{\uldb ')
else
OutFile('{\ul ');
SkipWhiteSpace;
Next;
case Sy of
BMCSy, BMLSy, BMRSy :
begin
DoBitmap;
while not ErrFlag and (Sy = Space) do
Next;
end;
else begin
while not ErrFlag and (Sy <> Colon) and (Sy <> EOLSy) do begin
OutFile(LCToken);
Next;
end;
end;
end;
OutFile('}');
if Sy <> Colon then begin
Error(Chi, 'Colon expected');
Exit;
end;
Next; {use up colon}
while not ErrFlag and (Sy = Space) do
Next;
if (Sy <> Ident) and (Sy <> Dot) and (Sy <> Number) then begin
Error(Chi, 'Syntax Error in cross reference');
Exit;
end;
OutFile('{\v ');
repeat
OutFile(LCToken);
Next;
until ErrFlag or ((Sy <> Ident) and (Sy <> Dot) and (Sy <> Number));
OutFile('}');
while not ErrFlag and (Sy = Space) do
Next;
if SyWas = LBrack then begin
if Sy <> RBrack then
Error(Chi, '] expected');
end else if Sy <> RRbrack then
Error(Chi, ']] expected');
end;
begin
while not ErrFlag
and (Sy <> ParaSy)
and (Sy <> TopicEnd)
and (Sy <> BlockStartSy)
and (Sy <> BlockEndSy) do begin
case Sy of
EOLSy : begin
OutFile(' ');
SkipWhiteSpace;
end;
LBrack,
LLbrack : CrossRef;
BMCSy,
BMLSy,
BMRSy : DoBitmap;
else
OutFile(LCToken);
end;
if ErrFlag then
Exit;
Next;
end;
if Sy = ParaSy then begin
repeat
Next; {skip trailing stuff, mainly spaces}
until ErrFlag or (Sy = EOLSy);
if not ErrFlag then
Next;
end;
end;
{-------------Paragraph}
procedure Paragraph;
var
Count : Integer;
S : String[10];
begin
repeat {repeat ignores blank lines with spaces}
while not ErrFlag and (Sy = EOLSy) do begin
OutFile('\par');
Next;
end;
Count := 0;
while not ErrFlag and ((Sy = Space) or (Sy = TabSy)) do begin
if Sy = TabSy then
Count := ((Count div 5) +1) * 5 + 1
else
Inc(Count);
Next;
end;
until ErrFlag or (Sy <> EOLSy);
if (Sy <> TopicEnd) and (Sy <> BlockStartSy) and (Sy <> BlockEndSy) then begin
if Count > 0 then begin
Str(Count * TwipsPerSpace:-1, S);
OutFile('\li'+S);
end;
{at start of each paragraph, output the paragraph commands entered in the headers}
if BIndex > 0 then
OutFile('{'+BlockHeader[BIndex])
else
OutFile('{'+GlobalHeader+TopicHeader);
ParagraphText; {do all the text}
OutFile('}\par\pard');
Flush;
end;
end;
{-------------DoTopic}
procedure DoTopic;
begin
OutFile('#{\footnote \pard\plain \sl240 \fs20 # ');
SkipWhiteSpace;
Next;
while not ErrFlag and ((Sy = Ident) or (Sy = Dot) or (Sy = Number)) do begin
OutFile(LCToken);
Next;
end;
if Sy <> ParaSy then
Error(Chi, 'Paragraph mark expected')
else
Next;
if not ErrFlag then begin
OutFile('}');
Flush;
end;
end;
{-------------DoBrowse}
procedure DoBrowse;
var
Err : boolean;
begin
OutFile('+{\footnote \pard\plain \sl240 \fs20 + ');
SkipWhiteSpace;
Next;
repeat {Browse symbol can contain many things up to ':' }
case Sy of
OtherChar, Comma,
SemiColon, Lbrack,
Rbrack, Dot,
Slash, OtherPunct,
Ident, Space,
TabSy, Number : Err := False;
else
Err := True;
end;
if Err then begin
Error(Chi, 'Syntax error in \Browse');
Exit;
end;
OutFile(LCToken);
Next;
until ErrFlag or ((Sy = Colon) or (Sy = ParaSy) or (Sy = EOLsy));
if Sy = Colon then begin
SkipWhiteSpace;
Next;
if Sy <> Number then begin
Error(Chi, 'Number expected in Browse');
Exit;
end;
OutFile(':'+LCToken);
SkipWhiteSpace;
Next;
end else
Error(Chi, 'Colon expected');
if Sy <> ParaSy then
Error(Chi, 'Paragraph mark expected');
if not ErrFlag then begin
OutFile('}');
Flush;
Next;
end;
end;
{-------------DoKeyWord}
procedure DoKeyWord;
var
Err : boolean;
Ch : Char;
S : String[10];
begin
case Sy of
KeyWordSy : Ch := 'K';
TitleSy : Ch := '$';
BuildTagSy : Ch := '*';
end;
S := LCToken; {save for possible error msg}
OutFile(Ch+'{\footnote \pard\plain \sl240 \fs20 '+Ch+' ');
SkipWhiteSpace;
Next;
repeat {symbols can contain many things }
case Sy of
OtherChar, Comma,
Colon, SemiColon,
Lbrack, Rbrack,
Dot, Slash,
OtherPunct, Ident,
Space, TabSy,
Number : Err := False;
else
Err := True;
end;
if Err then begin
Error(Chi, 'Syntax error in '+S);
Exit;
end;
OutFile(LCToken);
Next;
until ErrFlag or ((Sy = ParaSy) or (Sy = EOLSy));
if Sy <> ParaSy then begin
Error(Chi, 'Paragraph mark expected');
Exit;
end;
OutFile('}');
Flush;
Next;
end;
{-------------DoPage}
procedure DoPage;
begin
InTopic := True;
Next;
while not ErrFlag and (Sy <> TopicEnd) do
if Sy = BlockStartSy then begin
if BIndex >= 4 then begin
Error(Chi, 'Too many nested blocks');
Exit;
end else
Inc(BIndex);
BlockHeader[BIndex] := '';
Next;
while not ErrFlag and ((Sy <> ParaSy) and (Sy <> EOLSy)) do begin
if Sy = CommandSy then
BlockHeader[BIndex] := BlockHeader[BIndex]+LCToken
else if Sy <> Space then begin
Error(Chi, 'Command expected');
Exit;
end;
Next;
end;
if Sy = ParaSy then
Next;
if Sy = EOLSy then
Next;
end else if Sy = BlockEndSy then begin
if BIndex < 1 then begin
Error(Chi, 'Unmatched \blockend');
Exit;
end else
Dec(BIndex);
while not ErrFlag and (Sy <> EOLSy) do
Next; {\BlockEnd should be on its own line}
Next;
end else
Paragraph;
if not EofInf then
Next;
OutFile('}\page');
Flush;
if BIndex <> 0 then begin
Error(Chi, 'Unmatched \blockstart in previous topic');
Exit;
end;
InTopic := False;
if BrackCount <> 0 then begin
Error(Chi, '{..} imbalance in last topic');
Exit;
end;
end;
{-------------DoDocument}
procedure DoDocument;
begin
Flush;
Next;
if Sy <> DocEndSy then
OutFile('{');
while not ErrFlag and (Sy <> DocEndSy) do begin
case Sy of
TopicSy : DoTopic;
KeyWordSy,
BuildTagSy,
TitleSy :
DoKeyWord;
BrowseSy : DoBrowse;
TopicStart : begin
DoPage;
TopicHeader := ''; {get ready for a new topic header string}
while not ErrFlag and
((Sy = EOLSy)
or (Sy = space)
or (Sy = TabSy)) do
Next;
if Sy <> DocEndSy then
Outfile('{');
end;
EolSy : Next;
CommandSy : begin
TopicHeader := TopicHeader+LCToken; {add in commands}
Next;
end;
FontCommand : begin
OutFile(LCToken);
Next;
end;
else Next; {ignore other junk}
end;
if ErrFlag then
Exit;
end;
Flush;
OutFile('}');
end;
{-------------WRITEHEADING}
procedure WriteHeading;
begin
Writeln(Outf, '{\rtf1\ansi \deff0');
Writeln(Outf, '{\fonttbl{\f0\froman Tms Rmn;}{\f1\fdecor Symbol;}{\f2\fswiss Helv;}');
Writeln(Outf, '{\f3\fmodern Courier;}');
Writeln(Outf, '}');
Writeln(Outf, '{\colortbl;');
Writeln(Outf, '\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;');
Writeln(Outf, '\red0\green255\blue0;');
Writeln(Outf, '\red255\green0\blue255;\red255\green0\blue0;\red255\green255\blue0;');
Writeln(Outf, '\red255\green255\blue255;}');
if IOResult <> 0 then begin
Close(Outf);
Error(Lineno, 'I/O Error while creating File Header');
end;
end;
{-------------EWEXECUTE}
function EWExecute(RoutineId : word) : integer; export;
var
DotPos : word;
begin
SetWaitCursor(true);
LineCount := EWGetLineCount;
ErrCount := 0;
LineNo := 0;
BIndex := 0;
BrackCount := 0;
OutString := '';
GlobalHeader := '';
TopicHeader := '';
EofInf := False;
InTopic := False;
ErrFlag := False;
InInclude := False;
EWSaveFile(EWGetFileName(EWGetCurrentEditor));
EWWriteMessage('Compiling...');
UpdateWindow(EWGetWindowHandle);
OutName := StrPas(EWGetFileName(EWGetCurrentEditor));
DotPos := Pos('.', OutName);
if DotPos <> 0 then
Delete(OutName, DotPos, 255);
OutName := OutName + '.RTF';
Assign(Outf, OutName);
ReWrite(Outf);
WriteHeading;
OutFile('\f'+DefaultFont+'\fs'+DefaultFontSize);
St[0] := #0;
Chi := 1; {get the reading started}
GetCh;
Next;
while not ErrFlag and not EofInf and (Sy <> DocStartSy) do begin
if Sy = CommandSy then
GlobalHeader := GlobalHeader+LCToken
else if Sy = FontCommand then
OutFile(LCToken); {else ignore}
Next;
end;
if Sy = DocStartSy then
DoDocument;
Flush;
Close(Outf);
if ErrFlag then
Erase(Outf)
else
EWWriteMessage('Compiled successfully.');
SetWaitCursor(false);
end;
procedure LibExit; far;
begin
{-Remove menu item from the User Menu before unloading}
EWRemoveMenuEntry(RTFEntryId);
ExitProc := SaveExit;
end;
exports
EWExecute index 1;
begin
SaveExit := ExitProc;
ExitProc := @LibExit;
{-Extension attaches itself to the user Menu}
{ Two commands are made available. Therefore we create two menu entries}
RTFEntryId := EWAddMenuEntry('ewrtfgen', RTFTitle, 0, EWMNU_Extension, 0);
end.